home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / PowerMacOberon feb96 / Source / TextFrames3.Mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1996-01-29  |  63.0 KB  |  1,395 lines  |  [TEXT/.Ob4]

  1. Syntax10.Scn.Fnt
  2. Syntax10i.Scn.Fnt
  3. Syntax10b.Scn.Fnt
  4. Syntax8.Scn.Fnt
  5. Syntax12.Scn.Fnt
  6. FoldElems
  7. Syntax10.Scn.Fnt
  8.     VAR F: Display.Frame; loc: Location;
  9.     BEGIN
  10.         F := obj.F;
  11.         WITH F: Frame DO
  12.             Show(F, F.org  - 1);
  13.             LocateLine(F, F.Y+F.bot, loc);
  14.             obj.Update(FALSE, F.text.len, F.org, loc.org + loc.line.len)
  15.         ELSE
  16.         END
  17.     END LineDown;
  18. Syntax10.Scn.Fnt
  19.     VAR F: Display.Frame; loc: Location;
  20.     BEGIN
  21.         F := obj.F;
  22.         WITH F: Frame DO
  23.             Show(F, F.trailer.next.next.org);
  24.             LocateLine(F, F.Y+F.bot, loc);
  25.             obj.Update(FALSE, F.text.len, F.org, loc.org + loc.line.len)
  26.         ELSE
  27.         END
  28.     END LineUp;
  29. Syntax10.Scn.Fnt
  30.     VAR F: Display.Frame; loc: Location;
  31.     BEGIN
  32.         F := obj.F;
  33.         WITH F: Frame DO
  34.             LocateLine(F, F.Y + F.bot, loc);
  35.             Show(F, loc.org);
  36.             LocateLine(F, F.Y + F.bot, loc);
  37.             obj.Update(FALSE, F.text.len, F.org, loc.org + loc.line.len)
  38.         ELSE
  39.         END
  40.     END PageDown;
  41. Syntax10.Scn.Fnt
  42.     VAR F: Display.Frame;loc: Location; delta: INTEGER; org: LONGINT;
  43.     BEGIN
  44.         F := obj.F;
  45.         WITH F: Frame DO
  46.             LocateLine(F, F.Y + F.H - 1, loc);
  47.             org := loc.org;
  48.             delta := loc.y - F.Y - F.bot;
  49.             Back(F, delta, org);
  50.             Show(F, org);
  51.             LocateLine(F, F.Y + F.bot, loc);
  52.             obj.Update(FALSE, F.text.len, F.org, loc.org + loc.line.len)
  53.         ELSE
  54.         END
  55.     END PageUp;
  56. Syntax10.Scn.Fnt
  57.     VAR F: Display.Frame; org: LONGINT; t: TextLine;
  58.     BEGIN
  59.         F := obj.F;
  60.         IF dY # obj.sliderdY THEN
  61.             WITH F: Frame DO
  62.                 org := (F.text.len * dY) DIV (obj.h - obj.w*2 - obj.minW - obj.minW DIV 2);
  63.                 IF dY > obj.sliderdY THEN
  64.                     IF (org <= F.org) OR (org < F.trailer.next.next.org) THEN org := F.trailer.next.next.org
  65.                     END
  66.                 ELSIF dY < obj.sliderdY THEN
  67.                     IF org >= F.org THEN org := F.org - 1  END
  68.                 END;
  69.                 IF org # F.org THEN
  70.                     Show(F, org);
  71.                     obj.Update(pressed, F.text.len, F.org, F.trailer.org+F.trailer.len)
  72.                 END
  73.             ELSE
  74.             END
  75.         END
  76.     END UpdateView;
  77. Syntax10.Scn.Fnt
  78.     VAR pos: LONGINT; F: Display.Frame;
  79.     BEGIN
  80.         obj.TrackSlider^(mx, my, keysum);
  81.         F := obj.F;
  82.         WITH F: Frame DO
  83.             IF keysum = {middleKey, leftKey} THEN
  84.                 pos := F.text.len;
  85.                 Back(F, F.H - F.top - F.bot - 30 (* heuristic*), pos); Show(F,pos); 
  86.                 obj.CalculateSliderDim(F.text.len, F.org, F.trailer.org);
  87.                 obj.DrawSlider(FALSE)
  88.             ELSIF keysum = {middleKey, rightKey} THEN
  89.                 obj.UpdateView(FALSE, 0)
  90.             END
  91.         ELSE
  92.         END
  93.     END TrackSlider;
  94. Syntax10.Scn.Fnt
  95.     BEGIN
  96.         WITH F: Frame DO
  97.             obj.SetDim(F.X, F.Y, F.barW -1, F.H);
  98.             obj.CalculateSliderDim(F.text.len, F.org, F.trailer.org + F.trailer.len);
  99.             used := TRUE;
  100.             obj.HandleScrollBar^(F, mx, my, keysum);
  101.             used := FALSE
  102.         ELSE
  103.         END
  104.     END HandleScrollBar;
  105. MODULE TextFrames;    (** CAS/MH/HM 12.10.1993 / mf 12.10.93 / mah 26.7.94 **)(*CM  18.11.94 *)
  106.     IMPORT Macintosh, Modules, Input, Display, Fonts, Viewers, Oberon, MenuViewers,
  107.                 Texts, Files, ScrollBars;    (*CM  18.11.94 *)
  108.     CONST
  109.         (** update message IDs **)
  110.             replace* = 0; insert* = 1; delete* = 2;
  111.         (** units **)
  112.             mm* = 36000;  Unit* = 10000;
  113.         (** parc options **)
  114.             gridAdj* = 0;  leftAdj* = 1;  rightAdj* = 2;  pageBreak* = 3;    twoColumns* = 4;
  115.         (** maximum number of TAB stops in Parc **)
  116.             MaxTabs* = 32;
  117.         AdjMask = {leftAdj, rightAdj};
  118.         TAB = 9X; CR = 0DX; DEL = 7FX; CRSL = 0C4X; CRSR = 0C3X; LF = 0A4X; BRK = 0B9X; ShiftBRK = 0B8X;
  119.         CRSU = 0C1X; CRSD = 0C2X; DELRIGHT = 008X;        (*<< mah *) 
  120.         EOL = 093X; HOME = 091X; PGUP = 0ACX; PGDN = 0ADX; (*<< mah *) 
  121.         AdjustSpan = 30; MinTabWidth = 3 * mm; StdTabWidth = 4 * mm;
  122.         rightKey = 0; middleKey = 1; leftKey = 2; cancel = {rightKey, middleKey, leftKey};
  123.     TYPE
  124.         Parc* = POINTER TO ParcDesc;
  125.         ParcDesc* = RECORD (Texts.ElemDesc)
  126.             left*: LONGINT;    (** distance from (F.X + F.left); in units **)
  127.             first*: LONGINT;    (** first line indentation from P.left; in units **)
  128.             width*: LONGINT;    (** parc width; in units **)
  129.             lead*: LONGINT;    (** distance to previous line; in units **)
  130.             lsp*: LONGINT;    (** line spacing of text after P; in units **)
  131.             dsr*: LONGINT;    (** descender of text after P; in units **)
  132.             opts*: SET;
  133.             nofTabs*: INTEGER;
  134.             tab*: ARRAY MaxTabs OF LONGINT    (** in units **)
  135.         END;
  136.         TextLine = POINTER TO TextLineDesc;
  137.         Location* = RECORD
  138.             org*, pos*: LONGINT;
  139.             x*, y*, dx*, dy*: INTEGER;
  140.             line: TextLine
  141.         END;
  142.         TextLineDesc = RECORD
  143.             next: TextLine;
  144.             eot: BOOLEAN;                (* contains end of text *)    
  145.             indent: LONGINT;                (* line indentation in units *)
  146.             w, h, dsr: INTEGER;            (* bounding box clipped to frame (w including indent) *)
  147.             w0, nob: INTEGER;            (* unclipped width (including indent), number of contained blanks: nob > 0 if text line wraps around *)
  148.             org, len, span: LONGINT;    (* len ... characters w/o; span ... w/ trailing CR or white space, if any *)
  149.             P: Parc;                            (* last parc before this text line *)
  150.             pbeg: LONGINT                (* position of P *)
  151.         END;
  152.         Frame* = POINTER TO FrameDesc;
  153.         FrameDesc* = RECORD (Display.FrameDesc)
  154.             text*: Texts.Text;
  155.             org*: LONGINT;
  156.             col*, left*, right*, top*, bot*: INTEGER;
  157.             markH*: INTEGER;    (** position of tick mark in scroll bar (< 0 => no tick mark) **)
  158.             barW*: INTEGER;    (** scroll bar width **)
  159.             time*: LONGINT;    (** selection time **)
  160.             hasCar*, hasSel*, showsParcs*: BOOLEAN;    (** caret/selection present; parcs visible **)
  161.             carloc*, selbeg*, selend*: Location;
  162.             focus*: Display.Frame;    (** frame of nested element if this element contains the focus **)
  163.             trailer: TextLine    (* ring with trailer and header *)
  164.         END;
  165.         DisplayMsg* = RECORD (Texts.ElemMsg)
  166.             prepare*: BOOLEAN;
  167.             fnt*: Fonts.Font;
  168.             col*: SHORTINT;
  169.             pos*: LONGINT;    (** position in host text **)
  170.             frame*: Display.Frame;    (** ~prepare => host frame **)
  171.             X0*, Y0*: INTEGER;    (** ~prepare => receiver origin in screen space **)
  172.             indent*: LONGINT;    (** prepare => width already consumed in line, in units **)
  173.             elemFrame*: Display.Frame    (** optional return parameter **)
  174.         END;
  175.         TrackMsg* = RECORD (Texts.ElemMsg)
  176.             X*, Y*: INTEGER;
  177.             keys*: SET;
  178.             fnt*: Fonts.Font;
  179.             col*: SHORTINT;
  180.             pos*: LONGINT;    (** position in host text **)
  181.             frame*: Display.Frame;    (** host frame **)
  182.             X0*, Y0*: INTEGER    (** receiver origin in screen space **)
  183.         END;
  184.         FocusMsg* = RECORD (Texts.ElemMsg)
  185.             focus*: BOOLEAN;    (** whether to focus or to defocus **)
  186.             elemFrame*: Display.Frame;    (** focus/defocus target **)
  187.             frame*: Display.Frame    (** host frame **)
  188.         END;
  189.         NotifyMsg* = RECORD (Display.FrameMsg)
  190.             frame*: Display.Frame    (** host frame **)
  191.         END;
  192.         UpdateMsg* = RECORD (Display.FrameMsg)
  193.             id*: INTEGER;
  194.             text*: Texts.Text;
  195.             beg*, end*: LONGINT
  196.         END;
  197.         InsertElemMsg* = RECORD (Display.FrameMsg)
  198.             e*: Texts.Elem
  199.         END;
  200.         SelectMsg = RECORD (Display.FrameMsg)
  201.             text: Texts.Text;
  202.             beg, end: LONGINT;
  203.             time: LONGINT
  204.         END;
  205.         ScrollBarElem = POINTER TO ScrollBarElemDesc;                    
  206.         ScrollBarElemDesc = RECORD (ScrollBars.ScrollBarElemDesc)
  207.         END;
  208.         menuH*, barW*, left*, right*, top*, bot*: INTEGER;
  209.         defParc*: Parc;
  210.         (*shared globals => get rid off in a later version?*)
  211.         W, W0: Texts.Writer;
  212.         B: Texts.Buffer;
  213.         P: Parc;
  214.         pbeg: LONGINT;    (*inv T[pbeg] = P*)
  215.         R: Texts.Reader;
  216.         nextCh: CHAR;    (*inv Base(R) = T => T[Pos(R)-1] = nextCh]*)
  217.         par: Oberon.ParList;
  218.         neutralize: Oberon.ControlMsg;
  219.         scrollBar: ScrollBarElem; used: BOOLEAN;            (*CM  18.11.94 *)
  220.     PROCEDURE Min (x, y: INTEGER): INTEGER;
  221.     BEGIN IF x < y THEN RETURN x ELSE RETURN y END
  222.     END Min;
  223.     PROCEDURE Max (x, y: INTEGER): INTEGER;
  224.     BEGIN IF x > y THEN RETURN x ELSE RETURN y END
  225.     END Max;
  226.     PROCEDURE MarkMenu (F: Frame);
  227.         VAR R: Texts.Reader; V: Viewers.Viewer; T: Texts.Text; ch: CHAR;
  228.     BEGIN V := Viewers.This(F.X, F.Y);
  229.         IF (V IS MenuViewers.Viewer) & (V.dsc IS Frame) & (F # V.dsc) THEN
  230.             T := V.dsc(Frame).text;
  231.             IF T.len > 0 THEN Texts.OpenReader(R, T, T.len - 1); Texts.Read(R, ch) ELSE ch := 0X END;
  232.             IF ch # "!" THEN Texts.Write(W0, "!"); Texts.Append(T, W0.buf) END
  233.         END
  234.     END MarkMenu;
  235.     (* Element Subframes *)
  236.     PROCEDURE InvertBorder (F: Display.Frame);
  237.     BEGIN
  238.         Display.ReplPattern(Display.white, Display.grey1, F.X-1, F.Y-1, F.W+2, 1, Display.invert);
  239.         Display.ReplPattern(Display.white, Display.grey1, F.X-1, F.Y+F.H, F.W+2, 1, Display.invert);
  240.         Display.ReplPattern(Display.white, Display.grey1, F.X-1, F.Y, 1, F.H, Display.invert);
  241.         Display.ReplPattern(Display.white, Display.grey1, F.X+F.W, F.Y, 1, F.H, Display.invert)
  242.     END InvertBorder;
  243.     PROCEDURE InvalSubFrames (F: Frame; x, y, w, h: INTEGER);    (* removes and suspends all subframes partly in (x, y, w, h) *)
  244.         VAR p, f: Display.Frame; msg: MenuViewers.ModifyMsg;
  245.     BEGIN
  246.         IF (w > 0) & (h > 0) THEN f := F.dsc;
  247.             IF f # NIL THEN p := f; f := p.next END;
  248.             WHILE f # NIL DO
  249.                 IF (f.X < x + w) & (f.X + f.W > x) & (f.Y < y + h) & (f.Y + f.H > y) THEN p.next := f.next;
  250.                     msg.id := MenuViewers.reduce; msg.dY := 0; msg.Y := f.Y; msg.H := 0;
  251.                     f.handle(f, msg)
  252.                 ELSE p := f
  253.                 END;
  254.                 f := p.next
  255.             END;
  256.             f := F.dsc;
  257.             IF (f # NIL) & (f.X < x + w) & (f.X + f.W > x) & (f.Y < y + h) & (f.Y + f.H > y) THEN F.dsc := F.dsc.next;
  258.                 msg.id := MenuViewers.reduce; msg.dY := 0; msg.Y := f.Y; msg.H := 0;
  259.                 f.handle(f, msg)
  260.             END
  261.         END
  262.     END InvalSubFrames;
  263.     PROCEDURE ShiftSubFrames (F: Frame; oldY, newY, h: INTEGER);    (* shift (F.X, oldY, F.W, h) to (F.X, newY, F.W, h) *)
  264.         VAR f: Display.Frame; msg: MenuViewers.ModifyMsg;
  265.     BEGIN
  266.         IF oldY > newY THEN InvalSubFrames(F, F.X, newY, F.W, oldY - newY)
  267.         ELSE InvalSubFrames(F, F.X, oldY + h, F.W, newY - oldY)
  268.         END;
  269.         f := F.dsc;
  270.         WHILE f # NIL DO
  271.             IF (f.Y < oldY + h) & (f.Y + f.H > oldY) THEN INC(f.Y, newY - oldY);
  272.                 msg.id := MenuViewers.reduce; msg.dY := 0; msg.Y := f.Y; msg.H := f.H;
  273.                 f.handle(f, msg)
  274.             END;
  275.             f := f.next
  276.         END
  277.     END ShiftSubFrames;
  278.     PROCEDURE NotifySubFrames (F: Frame; VAR msg: Display.FrameMsg);
  279.         VAR p, f: Display.Frame;
  280.     BEGIN f := F.dsc;
  281.         IF msg IS NotifyMsg THEN msg(NotifyMsg).frame := F END;
  282.         WHILE f # NIL DO p := f; f := f.next; p.handle(p, msg) END
  283.     END NotifySubFrames;
  284.     (* Display Primitives *)
  285.     PROCEDURE DrawCursor (x, y: INTEGER);
  286.     BEGIN Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y)
  287.     END DrawCursor;
  288.     PROCEDURE TrackMouse (VAR x, y: INTEGER; VAR keys, keysum: SET);
  289.     BEGIN Input.Mouse(keys, x, y); keysum := keysum + keys; DrawCursor(x, y)
  290.     END TrackMouse;
  291.     PROCEDURE EraseRect (F: Frame; x, y, w, h: INTEGER);
  292.     BEGIN
  293.         Display.ReplConst(F.col, x, y, w, h, Display.replace); InvalSubFrames(F, x, y, w, h)
  294.     END EraseRect;
  295.     PROCEDURE Erase (F: Frame; x, y, w, h: INTEGER);    (*RemoveMarks optimization*)
  296.     BEGIN
  297.         IF h > 0 THEN Oberon.RemoveMarks(x, y, w, h); EraseRect(F, x, y, w, h) END
  298.     END Erase;
  299.     PROCEDURE Shift (F: Frame; oldY, newY, h: INTEGER);    (*RemoveMarks optimization*)
  300.     BEGIN
  301.         IF (oldY # newY) & (h > 0) THEN
  302.             Oberon.RemoveMarks(F.X + F.left, Min(oldY, newY), F.W - F.left, Max(oldY, newY) + h);
  303.             Display.CopyBlock(F.X + F.left, oldY, F.W - F.left, h, F.X + F.left, newY, Display.replace);
  304.             ShiftSubFrames(F, oldY, newY, h)
  305.         END
  306.     END Shift;
  307.     PROCEDURE InvertCaret (F: Frame);
  308.         VAR loc: Location; bot: INTEGER;
  309.     BEGIN loc := F.carloc; bot := loc.y + loc.line.dsr - 6;
  310.         Display.CopyPatternC(F, Display.white, Display.hook, loc.x, bot, Display.invert)
  311.     END InvertCaret;
  312.     PROCEDURE InvertRect (F: Frame; x, y, w, h: INTEGER);    (*clips to right and bottom frame margin*)
  313.     BEGIN
  314.         IF x + w > F.X + F.W - F.right THEN w := F.X + F.W - F.right - x END;
  315.         IF y >= F.Y + F.bot THEN Display.ReplConst(Display.white, x, y, w, h, Display.invert) END
  316.     END InvertRect;
  317.     PROCEDURE InvertSelection (F: Frame; beg, end: Location);
  318.         VAR t: TextLine; ex, rx, w, py: INTEGER;
  319.     BEGIN
  320.         rx := F.X + F.W - F.right; t := end.line;
  321.         IF t.eot OR (end.pos <= t.org + t.len) THEN ex := end.x ELSE ex := rx END;
  322.         IF beg.line = end.line THEN InvertRect(F, beg.x, beg.y, ex - beg.x, beg.line.h)
  323.         ELSE t := beg.line; py := beg.y; w := F.W - F.left - F.right;
  324.             InvertRect(F, beg.x, py, rx - beg.x, t.h); t := t.next; DEC(py, t.h);
  325.             WHILE t # end.line DO InvertRect(F, F.X + F.left, py, w, t.h); t := t.next; DEC(py, t.h) END;
  326.             InvertRect(F, F.X + F.left, py, ex - (F.X + F.left), t.h)
  327.         END
  328.     END InvertSelection;
  329.     PROCEDURE CoordToPos (F: Frame; mh: INTEGER): LONGINT;
  330.         VAR h: INTEGER;
  331.     BEGIN h := F.H - 1;
  332.         IF h > 0 THEN RETURN (h - mh) * F.text.len DIV h ELSE RETURN 0 END
  333.     END CoordToPos;
  334.     PROCEDURE ShowBar (F: Frame; botH, topH: INTEGER);
  335.     BEGIN
  336.         IF (F.left > F.barW) & (F.barW >= barW) THEN        (*CM  18.11.94 *)
  337.             scrollBar.F := F;            
  338.             scrollBar.SetDim(F.X, F.Y, F.barW -1, F.H);
  339.             IF (F.text = NIL) OR (F.trailer = NIL) THEN  scrollBar.CalculateSliderDim(0,0,0)
  340.             ELSE scrollBar.CalculateSliderDim(F.text.len, F.org, F.trailer.org + F.trailer.len)
  341.             END;            
  342.             scrollBar.Draw;
  343.             Display.ReplConst(Display.white, F.X + F.barW - 1, F.Y + botH, 1, topH - botH, Display.replace)
  344.         END
  345.     END ShowBar;
  346.     PROCEDURE Tick (F: Frame);        (*CM  18.11.94 *)
  347.     BEGIN
  348. (*        IF (0 <= F.markH) & (F.markH < F.H) & (F.left > F.barW) & (F.barW > 6) & (F.H > 2) THEN    
  349.             Display.ReplConst(Display.white, F.X + 1, F.Y + F.markH, F.barW - 6, 2, Display.invert)
  350.         END
  351. *)    END Tick;
  352.     PROCEDURE ShowTick (F: Frame);    (* removes global marks as needed *)
  353.         VAR h, mh: INTEGER; len: LONGINT;
  354.     BEGIN
  355.         h := F.H - 2; len := F.text.len;
  356.         IF len > 0 THEN mh := SHORT(h - h * F.org DIV len) ELSE mh := h END;
  357. (*        IF F.markH # mh THEN Oberon.RemoveMarks(F.X, F.Y, F.barW, F.H);        (*CM  18.11.94 *)
  358.             Tick(F); F.markH := mh; Tick(F)
  359.         END
  360.         Oberon.RemoveMarks(F.X, F.Y, F.barW, F.H);                (*CM  18.11.94 *)
  361.         IF ~used & (F.left > F.barW) & (F.barW >= barW) THEN
  362.             scrollBar.F := F;            
  363.             scrollBar.SetDim(F.X, F.Y, F.barW -1, F.H);            
  364.             scrollBar.CalculateSliderDim(F.text.len, F.org, F.trailer.org + F.trailer.len);
  365.             scrollBar.DrawSlider(FALSE)                                                    
  366.         END
  367.     END ShowTick;
  368.     PROCEDURE Mark* (F: Frame; mark: INTEGER);
  369.     BEGIN
  370. (*        Erase(F, F.X, F.Y, F.barW - 1, F.H); F.markH := -1;                (*CM  18.11.94 *)
  371.         IF (mark < 0) & (F.H >= 16) THEN
  372.             Display.CopyPattern(Display.white, Display.downArrow, F.X, F.Y, Display.invert) 
  373.         ELSIF mark > 0 THEN
  374.             ShowTick(F)
  375.         END
  376. *)    END Mark;
  377.     (** Parcs **)
  378.     PROCEDURE ParcBefore* (T: Texts.Text; pos: LONGINT; VAR P: Parc; VAR beg: LONGINT);
  379.         VAR R: Texts.Reader;
  380.     BEGIN Texts.OpenReader(R, T, pos + 1);
  381.         REPEAT Texts.ReadPrevElem(R) UNTIL R.eot OR (R.elem IS Parc);
  382.         IF R.eot THEN P := defParc; beg := -1 ELSE P := R.elem(Parc); beg := Texts.Pos(R) END
  383.     END ParcBefore;
  384.     PROCEDURE InitDefParc;
  385.     BEGIN
  386.         IF Modules.ThisMod("ParcElems") = NIL THEN HALT(99) END
  387.         (* side effect: body of ParcElems initialises defParc *)
  388.     END InitDefParc;
  389.     (* Screen Metrics *)
  390.     PROCEDURE Tab (dw: INTEGER; VAR dx: INTEGER);    (*P set*)
  391.         (* dw = line width from left margin to caret (in pixels); dx = distance from caret to next tab stop (in pixels) *)
  392.         VAR i, n: INTEGER; w: LONGINT;
  393.     BEGIN
  394.         i := 0; n := P.nofTabs; w := LONG(dw) * Unit + MinTabWidth;
  395.         IF dw < 0 THEN dx := -dw
  396.         ELSE
  397.             WHILE (i < n) & (P.tab[i] < w) DO INC(i) END;
  398.             IF i < n THEN dx := SHORT((P.tab[i] - LONG(dw) * Unit) DIV Unit)
  399.             ELSE dx := StdTabWidth DIV Unit
  400.             END
  401.         END
  402.     END Tab;
  403.     PROCEDURE MeasureSpecial (dw: INTEGER; VAR dx, x, y, w, h: INTEGER);
  404.         (* returns metrics of nextCh (nextCh <= " "); sends prepare message to elements; P, R, nextCh set *)
  405.         VAR e: Texts.Elem; pat: Display.Pattern; msg: DisplayMsg;
  406.     BEGIN
  407.         IF nextCh = " " THEN Display.GetChar(R.fnt.raster, nextCh, dx, x, y, w, h, pat);
  408.             x := 0; y := 0; w := dx; h := 0
  409.         ELSIF nextCh = TAB THEN Tab(dw, dx); x := 0; y := 0; w := dx; h := 0
  410.         ELSIF R.elem # NIL THEN e := R.elem;
  411.             msg.prepare := TRUE; msg.indent := LONG(dw) * Unit;
  412.             msg.fnt := R.fnt; msg.col := R.col; msg.pos := Texts.Pos(R)-1;
  413.             msg.Y0 := -SHORT(P.dsr DIV Unit);    (*<<< 18-Nov-91*)
  414.             e.handle(e, msg);
  415.             w := SHORT(e.W DIV Unit);
  416.             dx := w; x := 0; y := msg.Y0; h := SHORT(e.H DIV Unit)    (*<<< 18-Nov-91*)
  417.         ELSE Display.GetChar(R.fnt.raster, nextCh, dx, x, y, w, h, pat)
  418.         END
  419.     END MeasureSpecial;
  420.     PROCEDURE GetSpecial (F: Frame; VAR n: INTEGER; cn, ddx, dw: INTEGER; VAR dx, x, y, w, h: INTEGER);
  421.         (* returns metrics of nextCh (nextCh <= " "); no prepare message to elements; extends blanks for block adjust *)
  422.         (* cn ... add 1 pixel to first cn blanks (block adjust); ddx ... add ddx pixels to every blank (block adjust) *)
  423.         (*P, R, nextCh set*)
  424.         VAR e: Texts.Elem; pat: Display.Pattern;
  425.     BEGIN
  426.         IF nextCh = " " THEN Display.GetChar(R.fnt.raster, nextCh, dx, x, y, w, h, pat);
  427.             x := 0; y := 0; INC(dx, ddx); INC(n); IF n <= cn THEN INC(dx) END;    (*space correction for block adjustment*)
  428.             w := dx; h := 0
  429.         ELSIF nextCh = TAB THEN Tab(dw, dx); x := 0; y := 0; w := dx; h := 0
  430.         ELSIF R.elem # NIL THEN e := R.elem;
  431.             IF (e IS Parc) & (P.W = 9999 * Unit) THEN (* P gets this value in prepare message *)
  432.                 w := Min(SHORT((P.width + P.left) DIV Unit), F.W - F.right - F.left);
  433.                 e.W := LONG(w) * Unit
  434.             ELSE w := SHORT(e.W DIV Unit)
  435.             END;
  436.             dx := w; x := 0; y := -SHORT(P.dsr DIV Unit); h := SHORT(e.H DIV Unit)
  437.         ELSE Display.GetChar(R.fnt.raster, nextCh, dx, x, y, w, h, pat)
  438.         END
  439.     END GetSpecial;
  440.     PROCEDURE NextLine (T: Texts.Text; VAR org: LONGINT);    (*R, nextCh set; org = Texts.Pos(R)-1*)
  441.         VAR pat: Display.Pattern; pos, bk, d: LONGINT; width, tw, dx, x, y, w, h: INTEGER;
  442.             R1: Texts.Reader; peekCh: CHAR; indent: INTEGER;
  443.     BEGIN
  444.         tw := 0; dx := 0; w := 0; bk := -999;    (* bk = pos of last seperator *)
  445.         pos := org; ParcBefore(T, pos, P, pbeg); width := SHORT(P.width DIV Unit);
  446.         indent := 0;
  447.         IF org > 0 THEN Texts.OpenReader(R1, T, org - 1); Texts.Read(R1, peekCh);
  448.             IF (peekCh = CR) OR (R1.elem # NIL) & (R1.elem IS Parc) THEN indent := SHORT(P.first DIV Unit) END;
  449.         END;
  450.         INC(tw, indent);
  451.         LOOP INC(pos);    (*inv pos = Texts.Pos(R), ~R.eof => nextCh = text[pos-1]*)
  452.             IF R.eot OR (nextCh = CR) THEN EXIT END;
  453.             INC(tw, dx);
  454.             IF nextCh <= " " THEN MeasureSpecial(tw, dx, x, y, w, h)
  455.             ELSE Display.GetChar(R.fnt.raster, nextCh, dx, x, y, w, h, pat)
  456.             END;
  457.             IF tw + x + w > width THEN d := pos - bk;
  458.                 IF (d < AdjustSpan) & (nextCh > " ") THEN pos := bk
  459.                 ELSIF ((nextCh > " ") OR (nextCh = Texts.ElemChar)) & (pos > org + 1) THEN DEC(pos)
  460.                 END;
  461.                 Texts.OpenReader(R, T, pos); Texts.Read(R, nextCh);
  462.                 EXIT
  463.             END;
  464.             IF (nextCh <= " ") & (nextCh # Texts.ElemChar) THEN bk := pos END;
  465.             Texts.Read(R, nextCh)
  466.         END;
  467.         org := pos
  468.     END NextLine;
  469.     PROCEDURE BegOfLine (T: Texts.Text; VAR pos: LONGINT; adjust: BOOLEAN);
  470.         (* returns origin of line containing pos *)
  471.         VAR p, org: LONGINT;
  472.     BEGIN
  473.         IF pos <= 0 THEN pos := 0
  474.         ELSE
  475.             IF pos <= T.len THEN org := pos ELSE org := T.len END;
  476.             LOOP    (*search backwards for CR*)
  477.                 IF org = 0 THEN EXIT END;
  478.                 Texts.OpenReader(R, T, org - 1); Texts.Read(R, nextCh);
  479.                 IF nextCh = CR THEN EXIT END;
  480.                 DEC(org)
  481.             END;
  482.             IF adjust THEN    (*search forward for actual line origin*)
  483.                 Texts.OpenReader(R, T, org); Texts.Read(R, nextCh); p := org;
  484.                 REPEAT org := p; NextLine(T, p) UNTIL (p > pos) OR R.eot
  485.             END;
  486.             pos := org
  487.         END
  488.     END BegOfLine;
  489.     PROCEDURE AdjustMetrics (F: Frame; t: TextLine; VAR pw, tw, ddx, cn: INTEGER);    (*t.org set*)
  490.         (* pw ... x-coord of first char in line (in pixels); tw ... width of text line; ddx, cn ... see GetSpecial *)
  491.     BEGIN
  492.         P := t.P; pbeg := t.pbeg;
  493.         pw := F.left; tw := t.w; ddx := 0; cn := 0;
  494.         IF t.pbeg # t.org THEN
  495.             INC(pw, SHORT((P.left + t.indent) DIV Unit));
  496.             IF leftAdj IN P.opts THEN
  497.                 IF (rightAdj IN P.opts) & (t.nob > 0) THEN
  498.                     tw := SHORT(P.width DIV Unit); ddx := (tw - t.w0) DIV t.nob; cn := (tw - t.w0) MOD t.nob
  499.                 END
  500.             ELSIF rightAdj IN P.opts THEN INC(pw, SHORT(P.width DIV Unit) - t.w0)
  501.             ELSE (*center*) INC(pw, (SHORT(P.width DIV Unit) - t.w0) DIV 2)
  502.             END;
  503.             DEC(tw, SHORT(t.indent DIV Unit));
  504.         END
  505.     END AdjustMetrics;
  506.     (* Screen Placement *)
  507.     PROCEDURE DrawSpecial (F: Frame; px, py, x, y: INTEGER);    (*R, nextCh set*)
  508.         VAR e: Texts.Elem; pat: Display.Pattern; dx, w, h: INTEGER; msg: DisplayMsg;
  509.     BEGIN
  510.         IF (nextCh = TAB) OR (nextCh = CR) THEN (*skip*)
  511.         ELSIF R.elem # NIL THEN e := R.elem;
  512.             IF ~(e IS Parc) OR F.showsParcs THEN
  513.                 msg.prepare := FALSE; msg.fnt := R.fnt; msg.col := R.col; msg.pos := Texts.Pos(R) - 1;
  514.                 msg.frame := F; msg.X0 := px + x; msg.Y0 := py + y; msg.elemFrame := NIL;
  515.                 e.handle(e, msg);
  516.                 IF msg.elemFrame # NIL THEN msg.elemFrame.next := F.dsc; F.dsc := msg.elemFrame END;
  517.             ELSIF pageBreak IN e(Parc).opts THEN (*(e IS Parc) & ~F.showsParcs*)
  518.                 Display.ReplPattern(Display.white, Display.grey1, px + x, py, SHORT(e.W DIV Unit), 1, Display.replace)
  519.             END
  520.         ELSE Display.GetChar(R.fnt.raster, nextCh, dx, x, y, w, h, pat);
  521.             Display.CopyPattern(R.col, pat, px + x, py + y, Display.invert)
  522.         END;
  523.     END DrawSpecial;
  524.     PROCEDURE ShowLine (F: Frame; t: TextLine; left, right, py: INTEGER);
  525.         VAR pat: Display.Pattern; i: LONGINT; n, cn, lm, px, pw, tw, ddx, dx, x, y, w, h: INTEGER;
  526.     BEGIN
  527.         (* lm ... left parc margin in screen coord; pw ...  x of first char in frame coord *)
  528.         Texts.OpenReader(R, F.text, t.org); AdjustMetrics(F, t, pw, tw, ddx, cn);
  529.         lm := F.X + F.left + SHORT(P.left DIV Unit); px := F.X + pw; INC(py, t.dsr); i := 0; n := 0;
  530.         WHILE i < t.len DO Texts.Read(R, nextCh);
  531.             IF nextCh <= " " THEN GetSpecial(F, n, cn, ddx, px - lm, dx, x, y, w, h)
  532.             ELSE Display.GetChar(R.fnt.raster, nextCh, dx, x, y, w, h, pat)
  533.             END;
  534.             INC(y, R.fnt.height * R.voff DIV 64);
  535.             IF px + x + w <= right THEN
  536.                 IF px + x >= left THEN
  537.                     IF nextCh <= " " THEN DrawSpecial(F, px, py, x, y)
  538.                     ELSE 
  539.                         IF (R.col = Display.white) & ((F.col = Display.black) OR (F.col = Display.white)) THEN
  540.                             Display.CopyPattern(R.col, pat, px + x, py + y, Display.invert)
  541.                         ELSE
  542.                             Display.CopyPattern(R.col, pat, px + x, py + y, Display.paint)
  543.                         END
  544.                     END
  545.                 END;
  546.                 INC(px, dx); INC(i)
  547.             ELSE i := t.len
  548.             END
  549.         END
  550.     END ShowLine;
  551.     PROCEDURE ShowLines (F: Frame; botH, topH: INTEGER; erase: BOOLEAN);
  552.         VAR t: TextLine; ph: INTEGER;
  553.     BEGIN
  554.         t := F.trailer.next; ph := F.H - F.top;
  555.         WHILE (t # F.trailer) & (ph - t.h >= topH) DO DEC(ph, t.h); t := t.next END;
  556.         WHILE (t # F.trailer) & (ph - t.h >= botH) DO DEC(ph, t.h);
  557.             IF erase THEN Erase(F, F.X + F.left, F.Y + ph, F.W - F.right - F.left, t.h) END;
  558.             ShowLine(F, t, F.X + F.left, F.X + F.W - F.right, F.Y + ph); t := t.next
  559.         END
  560.     END ShowLines;
  561.     (* Screen Casting *)
  562.     PROCEDURE MeasureLine (F: Frame; maxW: INTEGER; t: TextLine);    (* R, nextCh set *)
  563.         VAR pat: Display.Pattern; len, bklen, d: LONGINT; eol: BOOLEAN;
  564.             nob, bknob, width, minY, bkminY, maxY, bkmaxY, tw, bktw, lsp, dsr, dx, x, y, w, h: INTEGER;
  565.             R1: Texts.Reader; peekCh: CHAR;
  566.             (* bk* ... backup for last blank *)
  567.     BEGIN
  568.         len := 0; nob := 0; bklen := -999; tw := 0; dx := 0; minY := 0; maxY := 0;
  569.         ParcBefore(F.text, t.org, P, pbeg);
  570.         lsp := SHORT(P.lsp DIV Unit); dsr := SHORT(P.dsr DIV Unit); width := SHORT(P.width DIV Unit);
  571.         t.indent := 0;
  572.         IF t.org > 0 THEN Texts.OpenReader(R1, F.text, t.org - 1); Texts.Read(R1, peekCh);
  573.             IF (peekCh = CR) OR (R1.elem # NIL) & (R1.elem IS Parc) THEN t.indent := P.first END;
  574.         END;
  575.         INC(tw, SHORT(t.indent DIV Unit));
  576.         LOOP
  577.             IF R.eot OR (nextCh = CR) THEN nob := 0; eol := ~R.eot; EXIT END;
  578.             IF nextCh <= " " THEN MeasureSpecial(tw, dx, x, y, w, h)
  579.             ELSE Display.GetChar(R.fnt.raster, nextCh, dx, x, y, w, h, pat)
  580.             END;
  581.             IF tw + x + w > width THEN d := len - bklen;
  582.                 IF (d < AdjustSpan) & (nextCh > " ") THEN eol := TRUE;
  583.                     Texts.OpenReader(R, F.text, Texts.Pos(R) - d);
  584.                     nob := bknob; len := bklen; tw := bktw; minY := bkminY; maxY := bkmaxY
  585.                 ELSIF len = 0 THEN    (* force at least one character on each line *)
  586.                     INC(len); INC(y, R.fnt.height * R.voff DIV 64); minY := Min(minY, y); maxY := Max(maxY, y + h);
  587.                     Texts.Read(R, nextCh); eol := FALSE; tw := maxW
  588.                 ELSE eol := (nextCh <= " ") & (nextCh # Texts.ElemChar)
  589.                 END;
  590.                 EXIT
  591.             END;
  592.             IF (nextCh <= " ") & (nextCh # Texts.ElemChar) THEN
  593.                 bknob := nob; bklen := len; bktw := tw; bkminY := minY; bkmaxY := maxY;
  594.                 IF nextCh = " " THEN INC(nob) END
  595.             END;
  596.             INC(len); INC(tw, dx); INC(y, R.fnt.height * R.voff DIV 64);
  597.             IF y < minY THEN minY := y END;
  598.             IF y + h > maxY THEN maxY := y + h END;
  599.             Texts.Read(R, nextCh)
  600.         END;
  601.         IF ~F.showsParcs & (pbeg = t.org) THEN dsr := 0; t.h := SHORT(P.lead DIV Unit) + 1
  602.         ELSIF gridAdj IN P.opts THEN
  603.             WHILE dsr < -minY DO INC(dsr, lsp) END;
  604.             t.h := Max(lsp, dsr + maxY); INC(t.h, (-t.h) MOD lsp)
  605.         ELSE dsr := Max(dsr, -minY); t.h := Max(lsp, dsr + maxY)
  606.         END;
  607.         t.len := len; t.w0 := tw; t.w := Min(tw, maxW); t.dsr := dsr; t.nob := nob; t.eot := R.eot; t.P := P; t.pbeg := pbeg;
  608.         IF eol THEN Texts.Read(R, nextCh); t.span := len + 1 ELSE t.span := len END
  609.     END MeasureLine;
  610.     PROCEDURE MeasureLines (F: Frame; org: LONGINT; VAR trailer: TextLine);
  611.         VAR s, t: TextLine; ph: INTEGER;
  612.     BEGIN
  613.         NEW(trailer); s := trailer;
  614.         Texts.OpenReader(R, F.text, org); Texts.Read(R, nextCh); ph := F.H - F.top;
  615.         LOOP NEW(t); t.org := org; MeasureLine(F, F.W - F.left - F.right, t);
  616.             IF ph - t.h < F.bot THEN EXIT END;
  617.             s.next := t; s := t; INC(org, s.span); DEC(ph, s.h);
  618.             IF R.eot THEN EXIT END
  619.         END;
  620.         s.next := trailer; trailer.eot := TRUE; trailer.org := org; (* start of first invisible line *) trailer.len := 0; trailer.w := 0;
  621.         trailer.h := SHORT(defParc.lsp DIV Unit); trailer.P := P (* P set by MeasureLine *) ; trailer.pbeg := pbeg
  622.     END MeasureLines;
  623.     (** Locators **)
  624.     PROCEDURE LocateLineTop (F: Frame; trailer: TextLine; org: LONGINT; VAR loc: Location);
  625.         VAR t: TextLine; ph: INTEGER;
  626.     BEGIN
  627.         ph := F.H - F.top; t := trailer.next;
  628.         WHILE (t # trailer) & (t.org # org) DO DEC(ph, t.h); t := t.next END;
  629.         loc.org := org; loc.line := t; loc.y := F.Y + ph
  630.     END LocateLineTop;
  631.     PROCEDURE Width (F: Frame; t: TextLine; pos: LONGINT; VAR pw, dx, dy: INTEGER);
  632.         VAR pat: Display.Pattern; i: LONGINT; n, mw, lm, tw, ddx, cn, x, y, w, h: INTEGER;
  633.     BEGIN
  634.         AdjustMetrics(F, t, pw, tw, ddx, cn); dy := 0; lm := F.left + SHORT(P.left DIV Unit);
  635.         IF t # F.trailer THEN Texts.OpenReader(R, F.text, t.org); Texts.Read(R, nextCh);
  636.             i := 0; n := 0; DEC(pos, t.org); dx := 0; mw := F.W - F.right;
  637.             WHILE ~R.eot & (i < t.len) & (i <= pos) & (pw + dx <= mw) DO
  638.                 (* i ... pos of nextCh; dx ... width of char before nextCh; pw ... line width up to pos (or up to right margin) *)
  639.                 INC(i); INC(pw, dx);
  640.                 IF nextCh <= " " THEN GetSpecial(F, n, cn, ddx, pw - lm, dx, x, y, w, h)
  641.                 ELSE Display.GetChar(R.fnt.raster, nextCh, dx, x, y, w, h, pat)
  642.                 END;
  643.                 dy := R.fnt.height * R.voff DIV 64;
  644.                 Texts.Read(R, nextCh)
  645.             END;
  646.             IF (i <= pos) & (pw + dx <= mw) THEN INC(i); INC(pw, dx) END
  647.         ELSE dx := 4
  648.         END
  649.     END Width;
  650.     PROCEDURE LocatePos* (F: Frame; pos: LONGINT; VAR loc: Location);    (* loc.dx = dx of char at pos *)
  651.         VAR t: TextLine; pw, dx, dy: INTEGER;
  652.     BEGIN
  653.         IF pos < F.org THEN pos := F.org; t := F.trailer.next
  654.         ELSIF pos < F.trailer.org THEN t := F.trailer;
  655.             WHILE (t.next # F.trailer) & (t.next.org <= pos) DO t := t.next END
  656.         ELSE pos := F.trailer.org; t := F.trailer.next;
  657.             WHILE ~t.eot DO t := t.next END
  658.         END;
  659.         Width(F, t, pos, pw, dx, dy); LocateLineTop(F, F.trailer, t.org, loc); DEC(loc.y, loc.line.h);
  660.         loc.org := t.org; loc.pos := pos; loc.x := F.X + pw; loc.dx := dx; loc.dy := dy; loc.line := t
  661.     END LocatePos;
  662.     PROCEDURE LocateLine* (F: Frame; y: INTEGER; VAR loc: Location);
  663.         (* loc.x = line start; loc.y = line bottom; loc.dx = line width *)
  664.         VAR t: TextLine; h, ph, pw, tw, ddx, cn: INTEGER;
  665.     BEGIN
  666.         t := F.trailer.next; h := y - F.Y; ph := F.H - F.top - t.h;
  667.         WHILE ~t.eot & (ph - t.next.h >= F.bot) & (ph > h) DO t := t.next; DEC(ph, t.h) END;
  668.         AdjustMetrics(F, t, pw, tw, ddx, cn);
  669.         IF pw >= F.W - F.right THEN pw := F.W - F.right - 4 END;
  670.         loc.org := t.org; loc.pos := loc.org; loc.x := F.X + pw; loc.y := F.Y + ph; loc.dx := tw; loc.dy := 0; loc.line := t
  671.     END LocateLine;
  672.     PROCEDURE LocateChar* (F: Frame; x, y: INTEGER; VAR loc: Location);
  673.         VAR t: TextLine; pat: Display.Pattern; i: LONGINT; n, w, lm, pw, tw, ddx, cn, dx, xc, yc, wc, hc: INTEGER;
  674.     BEGIN
  675.         LocateLine(F, y, loc); t := loc.line; w := x - F.X; AdjustMetrics(F, t, pw, tw, ddx, cn);
  676.         lm := F.left + SHORT(P.left DIV Unit);
  677.         IF (t # F.trailer) & (w > pw) THEN Texts.OpenReader(R, F.text, t.org);
  678.             i := 0; n := 0; dx := 0; nextCh := 0X;
  679.             WHILE (i < t.len) & (pw + dx < w) DO
  680.                 (* i = pos after nextCh; dx = width of nextCh; pw = line width without nextCh *)
  681.                 Texts.Read(R, nextCh); INC(i); INC(pw, dx);
  682.                 IF nextCh <= " " THEN GetSpecial(F, n, cn, ddx, pw - lm, dx, xc, yc, wc, hc)
  683.                 ELSE Display.GetChar(R.fnt.raster, nextCh, dx, xc, yc, wc, hc, pat)
  684.                 END
  685.             END;
  686.             IF pw + dx < w THEN INC(i); INC(pw, dx); R.elem := NIL END;
  687.             INC(loc.pos, i - 1); loc.x := F.X + pw;
  688.             IF i < t.len THEN loc.dx := dx; loc.dy := R.fnt.height * R.voff DIV 64 ELSE loc.dx := 4 END
  689.         ELSE loc.dx := 4; R.elem := NIL
  690.         END
  691.     END LocateChar;
  692.     PROCEDURE LocateWord* (F: Frame; x, y: INTEGER; VAR loc: Location);
  693.         VAR t: TextLine; pos, i: LONGINT; px, rx: INTEGER; pat: Display.Pattern; dx, xc, yc, wc, hc: INTEGER;
  694.     BEGIN
  695.         LocateChar(F, x, y, loc); pos := loc.pos + 1;
  696.         REPEAT DEC(pos); Texts.OpenReader(R, F.text, pos); Texts.Read(R, nextCh)
  697.         UNTIL (pos < loc.org) OR (nextCh > " ");
  698.         INC(pos);
  699.         REPEAT DEC(pos); Texts.OpenReader(R, F.text, pos); Texts.Read(R, nextCh)
  700.         UNTIL (pos < loc.org) OR (nextCh <= " ");
  701.         LocatePos(F, pos + 1, loc); t := loc.line; i := loc.pos - loc.org;
  702.         IF i < t.len THEN px := loc.x; rx := F.X + F.W - F.right;
  703.             Texts.OpenReader(R, F.text, loc.pos); dx := 0; wc := 0; nextCh := "x";
  704.             WHILE (i < t.len) & (nextCh > " ") & (px + dx < rx) DO
  705.                 Texts.Read(R, nextCh); INC(i); INC(px, dx);
  706.                 Display.GetChar(R.fnt.raster, nextCh, dx, xc, yc, wc, hc, pat)
  707.             END;
  708.             IF (nextCh > " ") & (px + dx < rx) THEN INC(i); INC(px, dx) END;
  709.             loc.dx := px - loc.x
  710.         ELSE loc.dx := 0
  711.         END
  712.     END LocateWord;
  713.     PROCEDURE Pos* (F: Frame; x, y: INTEGER): LONGINT;
  714.         VAR loc: Location;
  715.     BEGIN LocateChar(F, x, y, loc); RETURN loc.pos
  716.     END Pos;
  717.     PROCEDURE ThisSubFrame (F: Frame; x, y: INTEGER): Display.Frame;
  718.         VAR f: Display.Frame;
  719.     BEGIN f := F.dsc;
  720.         WHILE (f # NIL) & ((x < f.X) OR (x >= f.X + f.W) OR (y < f.Y) OR (y >= f.Y + f.H)) DO f := f.next END;
  721.         RETURN f
  722.     END ThisSubFrame;
  723.     (** Caret & Selection **)
  724.     PROCEDURE PassSubFocus (F: Frame; f: Display.Frame);
  725.         (* pass focus from F.focus to f (f is also an element frame in F) *)
  726.         VAR loc: Location; f1: Display.Frame; ctrl: Oberon.ControlMsg; focus: FocusMsg;
  727.     BEGIN
  728.         IF F.focus # NIL THEN f1 := F.focus;
  729.             ctrl.id := Oberon.defocus; f1.handle(f1, ctrl);
  730.             LocateChar(F, f1.X + 1, f1.Y + 1, loc);
  731.             InvertBorder(f1); F.focus := NIL;
  732.             IF R.elem # NIL THEN
  733.                 focus.focus := FALSE; focus.elemFrame := f1; focus.frame := F; R.elem.handle(R.elem, focus)
  734.             END
  735.         END;
  736.         IF f # NIL THEN
  737.             LocateChar(F, f.X + 1, f.Y + 1, loc);    (* side effect: set R to element *)
  738.             focus.focus := TRUE; focus.elemFrame := f; focus.frame := F; R.elem.handle(R.elem, focus);
  739.             InvertBorder(f)
  740.         END;
  741.         F.focus := f
  742.     END PassSubFocus;
  743.     PROCEDURE RemoveSelection* (F: Frame);
  744.     BEGIN
  745.         IF F.hasSel THEN InvertSelection(F, F.selbeg, F.selend); F.hasSel := FALSE END
  746.     END RemoveSelection;
  747.     PROCEDURE SetSelection* (F: Frame; beg, end: LONGINT);    (** forces range to visible bounds **)
  748.         VAR loc: Location;
  749.     BEGIN
  750.         IF end > F.text.len THEN end := F.text.len END;
  751.         IF end > beg THEN
  752.             IF F.hasSel & (F.selbeg.pos = beg) THEN
  753.                 IF (F.selend.pos < end) & (F.selend.pos < F.trailer.org) THEN
  754.                     LocatePos(F, F.selend.pos, loc); LocatePos(F, end, F.selend); InvertSelection(F, loc, F.selend)
  755.                 ELSIF end < F.selend.pos THEN
  756.                     LocatePos(F, end, loc); InvertSelection(F, loc, F.selend); LocatePos(F, end, F.selend)
  757.                 END
  758.             ELSE RemoveSelection(F); PassSubFocus(F, NIL);
  759.                 LocatePos(F, beg, F.selbeg); LocatePos(F, end, F.selend); InvertSelection(F, F.selbeg, F.selend)
  760.             END;
  761.             F.hasSel := TRUE; F.time := Oberon.Time()
  762.         END
  763.     END SetSelection;
  764.     PROCEDURE RemoveCaret* (F: Frame);
  765.         VAR msg: Oberon.ControlMsg;
  766.     BEGIN
  767.         IF F.focus # NIL THEN msg.id := Oberon.defocus; F.focus.handle(F.focus, msg) END;
  768.         IF F.hasCar THEN InvertCaret(F); F.hasCar := FALSE END
  769.     END RemoveCaret;
  770.     PROCEDURE SetCaret* (F: Frame; pos: LONGINT);    (** only done if within visible bounds **)
  771.     BEGIN
  772.         IF ~F.hasCar OR (F.carloc.pos # pos) THEN RemoveCaret(F); PassSubFocus(F, NIL);
  773.             LocatePos(F, pos, F.carloc);
  774.             IF F.carloc.x <= F.X + F.W - F.right THEN InvertCaret(F); F.hasCar := TRUE END
  775.         END
  776.     END SetCaret;
  777.     (** Display Range **)
  778.     PROCEDURE Complete (F: Frame; trailer: TextLine; s: TextLine; org: LONGINT; ph: INTEGER);
  779.         VAR u: TextLine;
  780.     BEGIN
  781.         IF ph > F.bot THEN    (*try to add new lines to the bottom*)
  782.             Texts.OpenReader(R, F.text, org); Texts.Read(R, nextCh);
  783.             LOOP
  784.                 IF R.eot THEN EXIT END;
  785.                 NEW(u); u.org := org; MeasureLine(F, F.W - F.left - F.right, u);
  786.                 IF ph - u.h < F.bot THEN EXIT END;
  787.                 s.next := u; s := s.next; DEC(ph, s.h); INC(org, s.span)
  788.             END
  789.         END;
  790.         s.next := trailer; trailer.eot := TRUE; trailer.org := org; trailer.len := 0; trailer.w := 0;
  791.         trailer.h := SHORT(defParc.lsp DIV Unit); trailer.P := P; trailer.pbeg := pbeg
  792.     END Complete;
  793.     PROCEDURE ShowFrom (F: Frame; pos: LONGINT);    (* removes global marks as needed and neutralizes F *)
  794.         VAR new, s: TextLine; beg, end: Location; org: LONGINT; ph, y0, dy: INTEGER;
  795.     BEGIN
  796.         F.handle(F, neutralize);
  797.         IF (F.trailer # NIL) & (F.org < pos) & (pos < F.trailer.org) THEN    (* shift up and extend to the bottom *)
  798.             LocateLineTop(F, F.trailer, pos, beg); LocateLineTop(F, F.trailer, F.trailer.org, end);
  799.             dy := (F.Y + F.H - F.top) - beg.y; Shift(F, end.y, end.y + dy, beg.y - end.y);
  800.             Erase(F, F.X + F.left, end.y, F.W - F.left, dy);
  801.             s := F.trailer.next; WHILE s.org # pos DO s := s.next END;
  802.             F.trailer.next := s; org := s.org + s.span; ph := F.H - F.top - s.h;
  803.             WHILE s.next # F.trailer DO s := s.next; org := org + s.span; ph := ph - s.h END;
  804.             Complete(F, F.trailer, s, org, ph); F.org := pos; ShowLines(F, F.bot, end.y + dy - F.Y, FALSE)
  805.         ELSIF (F.trailer = NIL) OR (pos # F.org) THEN
  806.             MeasureLines(F, pos, new);
  807.             IF (F.trailer # NIL) & (pos < F.org) & (F.org <= new.org) THEN    (* shift down and extend to the top *)
  808.                 LocateLineTop(F, new, F.org, beg); LocateLineTop(F, new, new.org, end);
  809.                 y0 := F.Y + F.H - F.top; Shift(F, y0 - (beg.y - end.y), end.y, beg.y - end.y);
  810.                 Erase(F, F.X + F.left, beg.y, F.W - F.left, y0 - beg.y);
  811.                 Erase(F, F.X + F.left, F.Y + F.bot, F.W - F.left, end.y - (F.Y + F.bot));
  812.                 F.org := pos; F.trailer := new; ShowLines(F, beg.y - F.Y, F.H - F.top, FALSE)
  813.             ELSE    (* full redisplay *)
  814.                 IF F.trailer = NIL THEN Erase(F, F.X, F.Y, F.W, F.H); ShowBar(F, 0, F.H); F.markH := -1
  815.                 ELSE Erase(F, F.X + F.left, F.Y + F.bot, F.W - F.left, F.H - F.bot - F.top)
  816.                 END;
  817.                 F.org := pos; F.trailer := new; ShowLines(F, F.bot, F.H - F.top, FALSE)
  818.             END
  819.         END;
  820.         ShowTick(F)
  821.     END ShowFrom;
  822.     PROCEDURE Show* (F: Frame; pos: LONGINT);    (** removes global marks as needed and neutralizes F **)
  823.     BEGIN BegOfLine(F.text, pos, TRUE); ShowFrom(F, pos)
  824.     END Show;
  825.     PROCEDURE Resize (F: Frame; x, y, w, h: INTEGER);
  826.         VAR oldY, oldH, dh, ph: INTEGER; t: TextLine;
  827.     BEGIN
  828.         IF (w = 0) OR (h = 0) THEN InvalSubFrames(F, F.X, F.Y, F.W, F.H);
  829.             F.X := x; F.Y := y; F.W := w; F.H := h; F.trailer := NIL
  830.         ELSIF (F.trailer # NIL) & (x = F.X) & (w = F.W) THEN
  831.             oldY := F.Y; oldH := F.H; Tick(F); F.markH := -1; F.Y := y; F.H := h;
  832.             IF h > oldH THEN dh := h - oldH;    (* extend *)
  833.                 IF y + h # oldY + oldH THEN
  834.                     Display.CopyBlock(x+F.barW, oldY, w-F.barW, oldH, x+F.barW, y + dh, Display.replace);    (*CM  18.11.94 *)
  835.                     ShiftSubFrames(F, oldY, y + dh, oldH)
  836.                 END;
  837.                 EraseRect(F, x, y, w, dh);                                                                                            (*CM  18.11.94 *)
  838.                 t := F.trailer; ph := F.H - F.top;
  839.                 WHILE t.next # F.trailer DO t := t.next; ph := ph - t.h END;
  840.                 Complete(F, F.trailer, t, F.trailer.org, ph); ShowLines(F, F.bot, ph, FALSE)
  841.             ELSE dh := oldH - h;    (* reduce *)
  842.                 IF y + h # oldY + oldH THEN
  843.                     Display.CopyBlock(x+F.barW, oldY + dh, w-F.barW, h, x+F.barW, y, Display.replace);        (*CM  18.11.94 *)
  844.                     ShiftSubFrames(F, oldY + dh, y, h)
  845.                 END;
  846.                 t := F.trailer; ph := F.H - F.top;
  847.                 WHILE (t.next # F.trailer) & (ph - t.next.h >= F.bot) DO t := t.next; DEC(ph, t.h) END;
  848.                 IF t = F.trailer THEN t.org := F.org; t.span := 0 END;
  849.                 Complete(F, F.trailer, t, t.org + t.span, ph);
  850.                 EraseRect(F, x + F.left, y, w - F.left, ph);
  851.                 InvalSubFrames(F, x, oldY, w, y - oldY); InvalSubFrames(F, x, y + h, w, dh - (y - oldY))
  852.             END;
  853.             ShowBar(F,0,h);                                                                                                            (*CM  18.11.94 *)
  854.             ShowTick(F)
  855.         ELSE F.X := x; F.Y := y; F.W := w; F.H := h; F.trailer := NIL; Show(F, F.org); ShowBar(F,0,h)
  856.         END
  857.     END Resize;
  858.     (** Contents Update **)
  859.     PROCEDURE Update (F: Frame; VAR msg: UpdateMsg);    (** removes global marks as needed **)
  860.         VAR t: TextLine; org, d: LONGINT;
  861.         PROCEDURE Begin (VAR beg: LONGINT; VAR org0: LONGINT; VAR q: TextLine);
  862.             (* org0 = origin of first affected line; beg = pos of first modified character; q = first affected line (if line origin has not moved).*)
  863.             (* q = NIL => beg = org0; q # NIL => first (beg-org0) characters of q need not be redrawn *)
  864.             VAR trailer, t: TextLine;
  865.         BEGIN
  866.             trailer := F.trailer; t := trailer; q := NIL;
  867.             WHILE (t.next # trailer) & (beg >= t.next.org + t.next.span) & ~t.next.eot DO t := t.next END;
  868.             q := t.next; org0 := beg; BegOfLine(F.text, org0, TRUE);
  869.             IF (org0 # q.org) OR (q = trailer) THEN
  870.                 IF org0 > q.org THEN org0 := q.org END;
  871.                 beg := org0; q := NIL
  872.             END
  873.         END Begin;
  874.         PROCEDURE Adjust (end, delta: LONGINT);
  875.             (* H1 = top of synchronization line in old frame *)
  876.             (* h0 = top of line that was modified *)
  877.             (* h1 = top of block in new frame that could be reused *)
  878.             (* h2 = bottom of last line in new frame *)
  879.             (* h1 - h2 = height of block that could be reused *)
  880.             VAR new, old, s, t, u, p, q: TextLine; bot: Location;
  881.                 org, org0, beg: LONGINT; ph, h0, h1, H1, h2, lm, dx, dy: INTEGER;
  882.         BEGIN
  883.             q := NIL; LocateLineTop(F, F.trailer, F.trailer.org, bot);
  884.             IF msg.beg < F.org THEN org0 := F.org; beg := org0 ELSE beg := msg.beg; Begin(beg, org0, q) END;
  885.             NEW(new); s := new; old := F.trailer; t := old; org := F.org; ph := F.H - F.top;
  886.             WHILE (t.next # old) & (t.next.org # org0) DO t := t.next;    (*transfer unchanged prefix*)
  887.                 s.next := t; s := t; DEC(ph, s.h); INC(org, s.span)
  888.             END;
  889.             h0 := ph; H1 := h0; t := t.next; p := s;
  890.             Texts.OpenReader(R, F.text, org); Texts.Read(R, nextCh);    (*rebuild at least one line descriptor*)
  891.             LOOP NEW(u); u.org := org; MeasureLine(F, F.W - F.left - F.right, u);
  892.                 IF ph - u.h < F.bot THEN h1 := ph; h2 := h1; EXIT END;
  893.                 s.next := u; s := s.next; DEC(ph, s.h); INC(org, s.span);
  894.                 IF R.eot THEN h1 := ph; h2 := h1; EXIT END;
  895.                 IF org > end THEN
  896.                     WHILE (t # old) & (org > t.org + delta) DO DEC(H1, t.h); t := t.next END;
  897.                     IF (org = t.org + delta) & (P = t.P) THEN h1 := ph;    (*resynchronized*)
  898.                         WHILE (t # old) & (ph - t.h >= F.bot) DO    (*transfer unchanged suffix*)
  899.                             s.next := t; s := t; s.org := org; ParcBefore(F.text, s.org, s.P, s.pbeg);
  900.                             DEC(ph, s.h); INC(org, s.span); t := t.next
  901.                         END;
  902.                         h2 := ph; EXIT
  903.                     END
  904.                 END
  905.             END;
  906.             Shift(F, F.Y + H1 - (h1 - h2), F.Y + h2, h1 - h2);
  907.             Complete(F, new, s, org, ph); F.trailer := new; t := p.next;
  908.             IF (q # NIL) & (q.h = t.h) & (q.dsr = t.dsr) & (q.org = t.org) & (q.P = t.P) & (end <= t.org + t.span) THEN
  909.                 P := t.P; pbeg := t.pbeg;
  910.                 IF (P.opts * AdjMask = {leftAdj}) OR (P.opts * AdjMask = AdjMask) & (q.nob = 0) & (t.nob = 0) THEN
  911.                     Width(F, t, beg, lm, dx, dy);    (*preserve prefix of first affected line*)
  912.                     DEC(h0, t.h); Erase(F, F.X + lm, F.Y + h0, F.W - lm, t.h);
  913.                     ShowLine(F, t, F.X + lm, F.X + F.W - F.right, F.Y + h0)
  914.                 END
  915.             END;
  916.             ShowLines(F, h1, h0, TRUE);
  917.             Erase(F, F.X + F.left, bot.y, F.W - F.left, h2 - (bot.y - F.Y)); ShowLines(F, F.bot, h2, FALSE)
  918.         END Adjust;
  919.     BEGIN F.handle(F, neutralize); MarkMenu(F);
  920.         IF (msg.id = Texts.insert) & (msg.beg < F.org) THEN t := F.trailer; d := msg.end - msg.beg; INC(F.org, d);
  921.             REPEAT INC(t.org, d); t := t.next UNTIL t = F.trailer
  922.         ELSIF (msg.id = Texts.delete) & (msg.end <= F.org) THEN t := F.trailer; d := msg.end - msg.beg; DEC(F.org, d);
  923.             REPEAT DEC(t.org, d); t := t.next UNTIL t = F.trailer
  924.         END;
  925.         org := F.org;
  926.         IF msg.beg <= F.org + AdjustSpan THEN BegOfLine(F.text, org, TRUE) END;
  927.         ParcBefore(F.text, org, P, d);
  928.         IF (org # F.org) OR (P # F.trailer.next.P) THEN
  929.             F.trailer := NIL; Show(F, F.org)
  930.         ELSIF (msg.end > org) & (msg.beg < F.trailer.org + AdjustSpan) THEN
  931.             IF msg.id = Texts.replace THEN Adjust(msg.end, 0)
  932.             ELSIF msg.id = Texts.insert THEN Adjust(msg.end, msg.end - msg.beg)
  933.             ELSIF msg.id = Texts.delete THEN Adjust(msg.beg, msg.beg - msg.end)
  934.             END
  935.         END;
  936.         ShowTick(F)
  937.     END Update;
  938.     (** User Interface **)
  939.     PROCEDURE Back (F: Frame; dY: INTEGER; (*inout*) VAR org: LONGINT);    (* mh 10.10.92 *)
  940.         (* computes new org such that old org is (at most) dY pixels below new org *)
  941.         VAR H: INTEGER; oldOrg: LONGINT;
  942.         PROCEDURE TotalHeight (org1, org2: LONGINT): INTEGER;
  943.             (* measures total height of text-lines starting at org1 and ending at the line before the line containing org2 *) 
  944.             VAR h: INTEGER; line: TextLine;
  945.         BEGIN
  946.             Texts.OpenReader(R, F.text, org1); Texts.Read(R, nextCh); NEW(line); h := 0;
  947.             LOOP line.org := org1;
  948.                 MeasureLine(F, F.W - F.left - F.right, line); INC(org1, line.span);
  949.                 IF Texts.Pos(R)-1 > org2 THEN EXIT END;
  950.                 INC(h, line.h);
  951.                 IF R.eot THEN EXIT END;
  952.             END;
  953.             RETURN h
  954.         END TotalHeight;
  955.         PROCEDURE Forward (h: INTEGER);
  956.             (* increase org by n text-lines such that the sum of the n line-heights > h *)
  957.             VAR line: TextLine;
  958.         BEGIN
  959.             Texts.OpenReader(R, F.text, org); Texts.Read(R, nextCh); NEW(line);
  960.             WHILE h > 0 DO line.org := org;
  961.                 MeasureLine(F, F.W - F.left - F.right, line); INC(org, line.span); DEC(h, line.h);
  962.             END;
  963.             org := Texts.Pos(R)-1;
  964.         END Forward;
  965.     BEGIN H := 0;
  966.         LOOP oldOrg := org;
  967.             IF org = 0 THEN EXIT END;
  968.             DEC(org, 800); BegOfLine(F.text, org, FALSE);
  969.             INC(H, TotalHeight(org, oldOrg));
  970.             IF H > dY THEN EXIT END;
  971.         END;
  972.         Forward(H - dY);
  973.     END Back;
  974.     PROCEDURE TrackLine* (F: Frame; VAR x, y: INTEGER; VAR org: LONGINT; VAR keysum: SET);
  975.         VAR keys: SET; new, old: Location;
  976.     BEGIN
  977.         LocateLine(F, y, old); InvertRect(F, old.x, old.y, old.dx + 4, 2); keysum := {};
  978.         REPEAT TrackMouse(x, y, keys, keysum); LocateLine(F, y, new);
  979.             IF new.org # old.org THEN
  980.                 InvertRect(F, new.x, new.y, new.dx + 4, 2); InvertRect(F, old.x, old.y, old.dx + 4, 2); old := new
  981.             END
  982.         UNTIL keys = {};
  983.         InvertRect(F, new.x, new.y, new.dx + 4, 2); org := new.org
  984.     END TrackLine;
  985.     PROCEDURE TrackWord* (F: Frame; VAR x, y: INTEGER; VAR pos: LONGINT; VAR keysum: SET);
  986.         VAR keys: SET; new, old: Location;
  987.     BEGIN 
  988.         LocateWord(F, x, y, old); InvertRect(F, old.x, old.y, old.dx, 2); keysum := {};
  989.         REPEAT TrackMouse(x, y, keys, keysum); LocateWord(F, x, y, new);
  990.             IF new.pos # old.pos THEN
  991.                 InvertRect(F, new.x, new.y, new.dx, 2); InvertRect(F, old.x, old.y, old.dx, 2); old := new
  992.             END
  993.         UNTIL keys = {};
  994.         InvertRect(F, new.x, new.y, new.dx, 2); pos := new.pos
  995.     END TrackWord;
  996.     PROCEDURE TrackCaret* (F: Frame; VAR x, y: INTEGER; VAR keysum: SET);
  997.         VAR keys: SET;
  998.     BEGIN keysum := {};
  999.         REPEAT TrackMouse(x, y, keys, keysum); SetCaret(F, Pos(F, x, y)) UNTIL keys = {}
  1000.     END TrackCaret;
  1001.     PROCEDURE TrackSelection* (F: Frame; VAR x, y: INTEGER; VAR keysum: SET);
  1002.         VAR keys: SET; pos: LONGINT; V: Viewers.Viewer; f: Frame;
  1003.     BEGIN
  1004.         V := Viewers.This(F.X, F.Y); V := V.next(Viewers.Viewer);
  1005.         IF (V.dsc # NIL) & (V.dsc.next # NIL) & (V.dsc.next IS Frame) THEN f := V.dsc.next(Frame);
  1006.             IF f.hasSel & (f.text = F.text) THEN
  1007.                 IF (f.selbeg.pos < f.trailer.org) & (f.org < f.selend.pos) & (f.selbeg.pos <= Pos(F, x, y)) THEN
  1008.                     SetSelection(F, f.selbeg.pos, Pos(F, x, y) + 1)
  1009.                 ELSE RemoveSelection(f); f := NIL
  1010.                 END
  1011.             ELSE f := NIL
  1012.             END
  1013.         ELSE f := NIL
  1014.         END;
  1015.         IF f = NIL THEN
  1016.             IF F.hasSel & (F.selbeg.pos + 1 = F.selend.pos) & (Pos(F, x, y) = F.selbeg.pos) THEN
  1017.                 SetSelection(F, F.selbeg.org, Pos(F, x, y) + 1)
  1018.             ELSE SetSelection(F, Pos(F, x, y), Pos(F, x, y) + 1)
  1019.             END
  1020.         END;
  1021.         keysum := {};
  1022.         REPEAT TrackMouse(x, y, keys, keysum); pos := Pos(F, x, y) + 1;
  1023.             IF F.hasSel THEN
  1024.                 IF pos > F.selbeg.pos THEN SetSelection(F, F.selbeg.pos, pos);
  1025.                     IF f # NIL THEN SetSelection(f, f.selbeg.pos, pos); f.selend.pos := F.selend.pos END
  1026.                 END
  1027.             ELSE SetSelection(F, Pos(F, x, y), Pos(F, x, y) + 1)
  1028.             END
  1029.         UNTIL keys = {};
  1030.         IF f # NIL THEN F.selbeg.pos := f.selbeg.pos END
  1031.     END TrackSelection;
  1032.     PROCEDURE Call (F: Frame; pos: LONGINT; new: BOOLEAN);
  1033.         VAR S: Texts.Scanner; res, i, j: INTEGER;
  1034.     BEGIN
  1035.         Texts.OpenScanner(S, F.text, pos); Texts.Scan(S);
  1036.         IF (S.class = Texts.Name) & (S.line = 0) THEN
  1037.             i := 0; WHILE (i < S.len) & (S.s[i] # ".") DO INC(i) END;
  1038.             j := i + 1; WHILE (j < S.len) & (S.s[j] # ".") DO INC(j) END;
  1039.             IF (j >= S.len) & (S.s[i] = ".") THEN
  1040.                 par.vwr := Viewers.This(F.X, F.Y);
  1041.                 par.frame := F; par.text := F.text; par.pos := pos + S.len;
  1042.                 Oberon.Call(S.s, par, new, res);
  1043.                 IF res > 0 THEN
  1044.                     Texts.WriteString(W0, "Call error: "); Texts.WriteString(W0, Modules.importing);    (* mf *)
  1045.                     IF res=1 THEN Texts.WriteString(W0, " not found")
  1046.                     ELSIF res=2 THEN Texts.WriteString(W0, " not a valid object file")
  1047.                     ELSIF res=3 THEN Texts.WriteString(W0, " imports "); Texts.WriteString(W0, Modules.imported);
  1048.                         Texts.WriteString(W0, " with bad key")
  1049.                     ELSIF res=4 THEN Texts.WriteString(W0, " not enough memory")
  1050.                     ELSIF res=5 THEN Texts.WriteString(W0, " module not found")
  1051.                     ELSIF res=6 THEN
  1052.                         IF Modules.importing[0]#CHR(0) THEN Texts.WriteString(W0, " command not found")
  1053.                         ELSE Texts.OpenWriter (W0);
  1054.                         END
  1055.                     ELSE Texts.WriteString(W0, " res = "); Texts.WriteInt(W0, res, 0)
  1056.                     END
  1057.                 ELSIF res < 0 THEN
  1058.                     IF i + 1 = S.len THEN Texts.OpenWriter(W0); res := 0  (*execution of module body*)
  1059.                     ELSE
  1060.                         INC(i); WHILE i < S.len DO Texts.Write(W0, S.s[i]); INC(i) END;
  1061.                         Texts.WriteString(W0, " not found")
  1062.                     END
  1063.                 END;
  1064.                 IF res # 0 THEN Texts.WriteLn(W0); Texts.Append(Oberon.Log, W0.buf) END
  1065.             END
  1066.         END
  1067.     END Call;
  1068.     PROCEDURE PickAttributes (VAR W: Texts.Writer; T: Texts.Text; pos: LONGINT);
  1069.         VAR R: Texts.Reader; ch: CHAR;
  1070.     BEGIN
  1071.         IF T.len > 0 THEN
  1072.             IF pos > 0 THEN Texts.OpenReader(R, T, pos-1); Texts.Read(R, ch)
  1073.             ELSE Texts.OpenReader(R, T, 0); Texts.Read(R, ch)
  1074.             END;
  1075.             Texts.SetFont(W, R.fnt); Texts.SetColor(W, R.col); Texts.SetOffset(W, R.voff);
  1076.         ELSE Texts.SetFont(W, Oberon.CurFnt); Texts.SetColor(W, Oberon.CurCol); Texts.SetOffset(W, Oberon.CurOff)
  1077.         END
  1078.     END PickAttributes;
  1079.     PROCEDURE ShiftBlock (F: Frame; delta: INTEGER);    (* shift selected lines to left or right *)
  1080.         VAR text: Texts.Text; pos, beg, end, time: LONGINT; select: SelectMsg; ch: CHAR;
  1081.     BEGIN
  1082.         Oberon.GetSelection(text, beg, end, time);
  1083.         IF (time >= 0) & (text = F.text) THEN BegOfLine(F.text, beg, FALSE); pos := beg;
  1084.             WHILE pos < end DO Texts.OpenReader(R, F.text, pos); Texts.Read(R, ch);
  1085.                 WHILE (R.elem # NIL) & (R.elem IS Parc) & (pos < end) DO Texts.Read(R, ch); INC(pos) END;
  1086.                 IF pos < end THEN
  1087.                     IF delta < 0 THEN
  1088.                         IF (ch <= " ") & (ch # CR) & (ch # Texts.ElemChar) THEN
  1089.                             Texts.Delete(F.text, pos, pos + 1); DEC(end)
  1090.                         END
  1091.                     ELSE
  1092.                         PickAttributes(W, text, pos);
  1093.                         IF (ch <= " ") & (ch # CR) & (ch # Texts.ElemChar) THEN Texts.Write(W, ch)    (* first char extension *)
  1094.                         ELSE Texts.Write(W, TAB)
  1095.                         END;
  1096.                         Texts.Insert(F.text, pos, W.buf); INC(end); INC(pos)
  1097.                     END;
  1098.                     Texts.OpenReader(R, F.text, pos);
  1099.                     REPEAT Texts.Read(R, ch) UNTIL R.eot OR (ch = CR);
  1100.                     pos := Texts.Pos(R)
  1101.                 END
  1102.             END;
  1103.             select.text := F.text; select.beg := beg; select.end := pos; select.time := Oberon.Time();
  1104.             Viewers.Broadcast(select)
  1105.         END
  1106.     END ShiftBlock;
  1107.     PROCEDURE Write (F: Frame; ch: CHAR; fnt: Fonts.Font; col, voff: SHORTINT);
  1108.         VAR loc: Location; parc: Parc; org, pos, pbeg: LONGINT; i: INTEGER;
  1109.             buf: ARRAY 32 OF CHAR;
  1110.             copy: Texts.CopyMsg; input: Oberon.InputMsg;
  1111.         PROCEDURE Visible(ch: CHAR): BOOLEAN;
  1112.             VAR pat: Display.Pattern; dx, x, y, w, h: INTEGER;
  1113.         BEGIN Display.GetChar(W.fnt.raster, ch, dx, x, y, w, h, pat); RETURN dx > 0
  1114.         END Visible;
  1115.         PROCEDURE InsertBuffer;
  1116.             VAR i, j: INTEGER; ch: CHAR;
  1117.         BEGIN i := 0; j := 0; ch := buf[i];
  1118.             WHILE ch # 0X DO
  1119.                 IF (ch = TAB) OR (ch = CR) OR (ch = " ") OR Visible(ch) THEN Texts.Write(W, ch); INC(j) END;
  1120.                 INC(i); ch := buf[i]
  1121.             END; 
  1122.             IF j > 0 THEN Texts.Insert(F.text, pos, W.buf); INC(pos, LONG(j)) END
  1123.         END InsertBuffer;
  1124.         PROCEDURE Flush;
  1125.             VAR ch: CHAR;
  1126.         BEGIN
  1127.             WHILE Input.Available() > 0 DO Input.Read(ch) END
  1128.         END Flush;
  1129.     BEGIN
  1130.         IF F.hasSel & (ch = CRSL) THEN ShiftBlock(F, -1)
  1131.         ELSIF F.hasSel & (ch = CRSR) THEN ShiftBlock(F, 1)
  1132.         ELSIF F.hasCar THEN pos := F.carloc.pos;
  1133.             IF ch = DEL THEN
  1134.                 IF pos > F.org THEN DEC(pos); Texts.Delete(F.text, pos, pos + 1); Flush END
  1135.             ELSIF (ch = DELRIGHT) & (pos < F.text.len) THEN Texts.Delete(F.text, pos, pos + 1); Flush        (*<< mah del right *)
  1136.             ELSIF ch = HOME THEN pos := Pos (F, F.X, F.carloc.y)                (*<< mah beg of line *)
  1137.             ELSIF ch = EOL THEN pos := Pos (F, F.X+F.W-1, F.carloc.y)        (*<< mah end of line *)
  1138.             ELSIF (ch = CRSL) & (pos > 0) THEN DEC(pos)
  1139.             ELSIF (ch = CRSR) & (pos < F.text.len) THEN INC(pos)
  1140.             ELSIF (ch = CRSU) & (pos > 0) THEN                                    (*<< mah cursor up *)
  1141.                 org:=Pos (F, F.carloc.x+1, F.carloc.y+F.carloc.line.h);
  1142.                 IF org=pos THEN Show (F, F.org-1) END;
  1143.                 pos:=Pos (F, F.carloc.x+1, F.carloc.y+F.carloc.line.h)
  1144.             ELSIF (ch = CRSD) & (pos < F.text.len) THEN                        (*<< mah cursor down *)
  1145.                 org:=Pos (F, F.carloc.x+1, F.carloc.y-F.carloc.line.next.h);
  1146.                 IF (org=pos) & (F.trailer.org+F.trailer.len#F.text.len) THEN Show (F, F.trailer.next.next.org) END;
  1147.                 LocatePos (F, pos, loc);
  1148.                 pos:=Pos (F, F.carloc.x+1, loc.y-loc.line.next.h)
  1149.             ELSIF ch=PGUP THEN                                                    (*<< mah page up *)
  1150.                 LocateLine (F, F.Y+F.H-1, loc); i:=loc.y-F.Y-F.bot;
  1151.                 Back (F, i, pos); Show (F, pos); pos:=F.org
  1152.             ELSIF ch=PGDN THEN                                                (*<< mah page down *)
  1153.                 IF F.trailer.org+F.trailer.len = F.text.len THEN pos:=F.trailer.org
  1154.                 ELSE LocateLine (F, F.Y, loc); Show (F, loc.org); pos:=F.org
  1155.                 END
  1156.             ELSIF (ch = CRSL) OR (ch = CRSU) OR (ch = CRSD) OR (ch = CRSR) OR (ch = PGUP) OR (ch=PGDN) THEN 
  1157.             ELSIF (ch = BRK) OR (ch = ShiftBRK) THEN
  1158.                 ParcBefore(F.text, pos, P, pbeg); P.handle(P, copy); parc := copy.e(Parc);
  1159.                 IF ch = BRK THEN EXCL(parc.opts, pageBreak) ELSE INCL(parc.opts, pageBreak) END;
  1160.                 PickAttributes(W, F.text, pos);
  1161.                 Texts.WriteElem(W, parc); Texts.Insert(F.text, pos, W.buf); INC(pos)
  1162.             ELSIF (ch = TAB) OR (ch = CR) OR (ch >= " ") THEN
  1163.                 PickAttributes(W, F.text, pos);
  1164.                 IF ch = CR THEN buf[0] := CR; i := 1; org := F.carloc.org; BegOfLine(F.text, org, FALSE);
  1165.                     Texts.OpenReader(R, F.text, org);
  1166.                     REPEAT Texts.Read(R, ch) UNTIL (R.elem = NIL) OR ~(R.elem IS Parc);
  1167.                     WHILE (Texts.Pos(R) <= pos) & (ch <= " ") & (ch # Texts.ElemChar) & (i < 31) DO
  1168.                         buf[i] := ch; INC(i); Texts.Read(R, ch)
  1169.                     END
  1170.                 ELSIF ch = LF THEN buf[0] := CR; i:=1            (*<< mah Enter on numeric pad has no autoindent *)
  1171.                 ELSE buf[0] := ch; i := 1
  1172.                 END;
  1173.                 buf[i] := 0X; InsertBuffer
  1174.             END;
  1175.             IF pos < F.org THEN Show(F, F.org - 1) END;
  1176.             SetCaret(F, pos);
  1177.             WHILE F.carloc.y < F.Y + F.bot DO Show(F, F.trailer.next.next.org); Flush; SetCaret(F, pos) END
  1178.         ELSIF F.focus # NIL THEN input.id := Oberon.consume; input.ch := ch;
  1179.             input.fnt := fnt; input.col := col; input.voff := voff; F.focus.handle(F.focus, input)
  1180.         END
  1181.     END Write;
  1182.     PROCEDURE TouchElem (F: Frame; VAR x, y: INTEGER; VAR keysum: SET);
  1183.         VAR loc: Location; e: Texts.Elem; pbeg: LONGINT; y0: INTEGER;
  1184.             track: TrackMsg;
  1185.     BEGIN
  1186.         LocateChar(F, x, y, loc); e := R.elem;
  1187.         IF (e # NIL) & (loc.x + e.W DIV Unit <= F.X + F.W - F.right) THEN
  1188.             ParcBefore(F.text, loc.pos, P, pbeg); y0 := loc.y + loc.line.dsr - SHORT(P.dsr DIV Unit) + loc.dy;
  1189.             IF (loc.x <= x) & (x < loc.x + e.W DIV Unit) & (keysum= {middleKey}) THEN
  1190.                 track.X := x; track.Y := y; track.keys := keysum;
  1191.                 track.fnt := R.fnt; track.col := R.col; track.pos := Texts.Pos(R) - 1;
  1192.                 track.frame := F; track.X0 := loc.x; track.Y0 := y0;
  1193.                 e.handle(e, track); keysum := {}
  1194.             END
  1195.         END
  1196.     END TouchElem;
  1197.     PROCEDURE Edit (F: Frame; x, y: INTEGER; keysum: SET);
  1198.         VAR ef: Display.Frame; text: Texts.Text; beg, end, time, pos: LONGINT; keys: SET; ch: CHAR;
  1199.             loc: Location; delta, res: INTEGER; copyover: Oberon.CopyOverMsg; input: Oberon.InputMsg;
  1200.     BEGIN
  1201.         IF x < F.X + F.barW THEN pos := F.org;    (* scroll bar *)
  1202.             IF leftKey IN keysum THEN TrackLine(F, x, y, pos, keysum);
  1203.             ELSIF rightKey IN keysum THEN TrackLine(F, x, y, pos, keysum); LocateLine(F, y, loc);
  1204.                 pos := F.org; delta := loc.y - (F.Y + F.bot); Back(F, delta, pos)
  1205.             ELSIF middleKey IN keysum THEN
  1206.                 REPEAT TrackMouse(x, y, keys, keysum) UNTIL keys = {};
  1207.                 IF keysum = {middleKey, leftKey} THEN pos := F.text.len; (*BegOfLine(F.text, pos, TRUE);*)
  1208.                     Back(F, F.H - F.bot - F.top - 30 (*heuristic*), pos);
  1209.                 ELSIF keysum = {middleKey, rightKey} THEN pos := 0
  1210.                 ELSIF (F.Y <= y) & (y <= F.Y + F.H) THEN pos := CoordToPos(F, y - F.Y); BegOfLine(F.text, pos, TRUE)
  1211.                 END
  1212.             ELSE DrawCursor(x, y); keysum := cancel
  1213.             END;
  1214.             IF keysum # cancel THEN ShowFrom(F, pos) END
  1215.         ELSE    (* text area *)
  1216.             ef := ThisSubFrame(F, x, y);
  1217.             IF ef # NIL THEN    (* within sub-frame *)
  1218.                 IF (F.focus # ef) & (keysum = {leftKey}) THEN
  1219.                     REPEAT TrackMouse(x, y, keys, keysum) UNTIL keys = {};
  1220.                     IF keysum = {leftKey} THEN RemoveSelection(F); RemoveCaret(F); PassSubFocus(F, ef); RETURN END
  1221.                 ELSIF F.focus = ef THEN input.id := Oberon.track; input.keys := keysum; input.X := x; input.Y := y;
  1222.                     ef.handle(ef, input); RETURN
  1223.                 END
  1224.             END;
  1225.             IF keysum # {} THEN TouchElem(F, x, y, keysum);
  1226.                 IF keysum = {} THEN RETURN END
  1227.             END;
  1228.             IF leftKey IN keysum THEN Oberon.PassFocus(Viewers.This(F.X, F.Y)); TrackCaret(F, x, y, keysum);
  1229.                 IF (keysum = {leftKey, middleKey}) & F.hasCar THEN Oberon.GetSelection(text, beg, end, time);
  1230.                     IF time >= 0 THEN Texts.Save(text, beg, end, B);
  1231.                         Texts.Insert(F.text, F.carloc.pos, B); SetCaret(F, F.carloc.pos + (end - beg))
  1232.                     END
  1233.                 ELSIF (keysum = {leftKey, rightKey}) & F.hasCar & (F.carloc.pos < F.text.len) THEN
  1234.                     Oberon.GetSelection(text, beg, end, time);
  1235.                     IF time >= 0 THEN Texts.OpenReader(R, F.text, F.carloc.pos); Texts.Read(R, ch);
  1236.                         Texts.ChangeLooks(text, beg, end, {0, 1, 2}, R.fnt, R.col, R.voff)
  1237.                     END
  1238.                 END
  1239.             ELSIF middleKey IN keysum THEN TrackWord(F, x, y, pos, keysum);
  1240.                 IF keysum # cancel THEN
  1241.                     IF rightKey IN keysum THEN
  1242.                         par.vwr := Viewers.This(F.X, F.Y);
  1243.                         par.frame := F; par.text := F.text; par.pos := pos;
  1244.                         Oberon.Call("Edit.Open", par, FALSE, res)
  1245.                     ELSE
  1246.                         Call(F, pos, keysum = {middleKey, leftKey})
  1247.                     END
  1248.                 END
  1249.             ELSIF rightKey IN keysum THEN TrackSelection(F, x, y, keysum);
  1250.                 IF (keysum = {rightKey, middleKey}) & F.hasSel THEN
  1251.                     copyover.text := F.text; copyover.beg := F.selbeg.pos; copyover.end := F.selend.pos;
  1252.                     Oberon.FocusViewer.handle(Oberon.FocusViewer, copyover)
  1253.                 ELSIF (keysum = {rightKey, leftKey}) & F.hasSel THEN Oberon.PassFocus(Viewers.This(F.X, F.Y));
  1254.                     Texts.Delete(F.text, F.selbeg.pos, F.selend.pos); SetCaret(F, F.selbeg.pos)
  1255.                 END
  1256.             ELSE DrawCursor(x, y)
  1257.             END
  1258.         END
  1259.     END Edit;
  1260.     (** General **)
  1261.     PROCEDURE Copy (SF, DF: Frame);
  1262.     BEGIN
  1263.         DF.handle := SF.handle; DF.text := SF.text; DF.org := SF.org;
  1264.         DF.col := SF.col; DF.left := SF.left; DF.right := SF.right; DF.top := SF.top; DF.bot := SF.bot;
  1265.         DF.barW := SF.barW; DF.hasCar := FALSE; DF.hasSel := FALSE; DF.showsParcs := SF.showsParcs;
  1266.         DF.focus := NIL; DF.trailer := NIL
  1267.     END Copy;
  1268.     PROCEDURE Handle* (f: Display.Frame; VAR msg: Display.FrameMsg);
  1269.         VAR F, F1: Frame; pos: LONGINT;
  1270.     BEGIN F := f(Frame);
  1271.         IF msg IS Oberon.InputMsg THEN
  1272.             WITH msg: Oberon.InputMsg DO
  1273.                 IF msg.id = Oberon.consume THEN Write(F, msg.ch, msg.fnt, msg.col, msg.voff)
  1274.                 ELSIF msg.id = Oberon.track THEN
  1275.                     IF (msg.X < F.X + F.barW) THEN        (*CM  18.11.94 *)
  1276.                         scrollBar.HandleScrollBar(F, msg.X, msg.Y, msg.keys)
  1277.                     ELSIF (msg.X >= F.X + F.barW) THEN
  1278.                         Edit(F, msg.X, msg.Y, msg.keys)
  1279.                     END
  1280.                 END
  1281.             END
  1282.         ELSIF msg IS Oberon.ControlMsg THEN
  1283.             WITH msg: Oberon.ControlMsg DO
  1284.                 IF msg.id = Oberon.defocus THEN RemoveCaret(F)
  1285.                 ELSIF msg.id = Oberon.neutralize THEN
  1286.                     RemoveCaret(F); RemoveSelection(F); PassSubFocus(F, NIL); NotifySubFrames(F, msg)
  1287.                 ELSE NotifySubFrames(F, msg)
  1288.                 END
  1289.             END
  1290.         ELSIF msg IS Oberon.CopyMsg THEN
  1291.             WITH msg: Oberon.CopyMsg DO
  1292.                 IF msg.F = NIL THEN NEW(F1); msg.F := F1 END;
  1293.                 Copy(F, msg.F(Frame))
  1294.             END
  1295.         ELSIF msg IS UpdateMsg THEN NotifySubFrames(F, msg);
  1296.             WITH msg: UpdateMsg DO
  1297.                 IF msg.text = F.text THEN Update(F, msg) END
  1298.             END
  1299.         ELSIF msg IS InsertElemMsg THEN
  1300.             IF F.hasCar THEN pos := F.carloc.pos;
  1301.                 PickAttributes(W, F.text, pos);
  1302.                 Texts.WriteElem(W, msg(InsertElemMsg).e);
  1303.                 Texts.Insert(F.text, pos, W.buf);
  1304.                 SetCaret(F, pos + 1)
  1305.             END
  1306.         ELSIF msg IS Oberon.SelectionMsg THEN NotifySubFrames(F, msg);
  1307.             WITH msg: Oberon.SelectionMsg DO
  1308.                 IF F.hasSel & (F.time > msg.time) THEN
  1309.                     msg.text := F.text; msg.beg := F.selbeg.pos; msg.end := F.selend.pos; msg.time := F.time
  1310.                 END
  1311.             END
  1312.         ELSIF msg IS Oberon.CopyOverMsg THEN NotifySubFrames(F, msg);
  1313.             WITH msg: Oberon.CopyOverMsg DO
  1314.                 IF F.hasCar THEN Texts.Save(msg.text, msg.beg, msg.end, B);
  1315.                     Texts.Insert(F.text, F.carloc.pos, B); SetCaret(F, F.carloc.pos + (msg.end - msg.beg))
  1316.                 END
  1317.             END
  1318.         ELSIF msg IS MenuViewers.ModifyMsg THEN
  1319.             WITH msg: MenuViewers.ModifyMsg DO
  1320.                 F.handle(F, neutralize); Resize(F, F.X, msg.Y, F.W, msg.H)
  1321.             END
  1322.         ELSIF msg IS SelectMsg THEN NotifySubFrames(F, msg);
  1323.             WITH msg: SelectMsg DO
  1324.                 IF (msg.text = F.text) & ~F.hasSel THEN Oberon.RemoveMarks(F.X, F.Y, F.W, F.H);
  1325.                     F.handle(F, neutralize);
  1326.                     SetSelection(F, msg.beg, msg.end); F.time := msg.time;
  1327.                     IF F.hasSel THEN F.selbeg.pos := msg.beg; F.selend.pos := msg.end END
  1328.                 END
  1329.             END
  1330.         ELSE NotifySubFrames(F, msg)
  1331.         END
  1332.     END Handle;
  1333.     PROCEDURE Open* (F: Frame; T: Texts.Text; pos: LONGINT);
  1334.     BEGIN
  1335.         F.handle := Handle; F.text := T; F.org := pos; F.col := Display.black;
  1336.         F.left := left; F.right := right; F.top := top; F.bot := bot;
  1337.         F.barW := barW; F.hasCar := FALSE; F.hasSel := FALSE; F.showsParcs := FALSE; F.trailer := NIL
  1338.     END Open;
  1339.     PROCEDURE NotifyDisplay* (T: Texts.Text; op: INTEGER; beg, end: LONGINT);
  1340.         VAR msg: UpdateMsg;
  1341.     BEGIN
  1342.         msg.text := T; msg.id := op; msg.beg := beg; msg.end := end; Viewers.Broadcast(msg)
  1343.     END NotifyDisplay;
  1344.     PROCEDURE Text* (name: ARRAY OF CHAR): Texts.Text;
  1345.         VAR text: Texts.Text;
  1346.     BEGIN
  1347.         NEW(text); Texts.Open(text, name); text.notify := NotifyDisplay; RETURN text
  1348.     END Text;
  1349.     PROCEDURE NewText* (T: Texts.Text; pos: LONGINT): Frame;
  1350.         VAR frame: Frame;
  1351.     BEGIN
  1352.         NEW(frame); Open(frame, T, pos);
  1353.         RETURN frame
  1354.     END NewText;
  1355.     PROCEDURE NewMenu* (name, commands: ARRAY OF CHAR): Frame;
  1356.         VAR T, T1: Texts.Text; buf: Texts.Buffer; frame: Frame; fn: ARRAY 32 OF CHAR; i: INTEGER;
  1357.     BEGIN
  1358.         T := Text("");
  1359.         Texts.WriteString(W0, name); Texts.WriteString(W0, " | "); Texts.Append(T, W0.buf);
  1360.         IF commands[0] = "^" THEN
  1361.             i := 0; REPEAT INC(i); fn[i-1] := commands[i] UNTIL commands[i] = 0X;
  1362.             IF Files.Old(fn) = NIL THEN
  1363.                 Texts.WriteString(W0, "System.Close  System.Grow  System.Copy Edit.Store "); Texts.Append(T, W0.buf)
  1364.             ELSE
  1365.                 NEW(T1); Texts.Open(T1, fn);
  1366.                 NEW(buf); Texts.OpenBuf(buf); Texts.Save(T1, 0, T1.len, buf); Texts.Append(T, buf)
  1367.             END
  1368.         ELSE
  1369.             Texts.WriteString(W0, commands); Texts.Append(T, W0.buf)
  1370.         END;
  1371.         NEW(frame); Open(frame, T, 0);
  1372.         frame.col := Display.white; frame.left := 6; frame.top := 0; frame.bot := 0; frame.barW := 0;
  1373.         RETURN frame
  1374.     END NewMenu;
  1375. (*CM  18.11.94 *)
  1376.     PROCEDURE (obj: ScrollBarElem) LineDown;
  1377.     PROCEDURE (obj: ScrollBarElem) LineUp;
  1378.     PROCEDURE (obj: ScrollBarElem) PageDown;
  1379.     PROCEDURE (obj: ScrollBarElem) PageUp;
  1380.     PROCEDURE (obj: ScrollBarElem) UpdateView(pressed: BOOLEAN; dY: INTEGER);
  1381.     PROCEDURE (obj: ScrollBarElem) TrackSlider(VAR mx, my : INTEGER; VAR keysum : SET);
  1382.     PROCEDURE (obj: ScrollBarElem) HandleScrollBar (F: Display.Frame; mx, my : INTEGER; 
  1383.                                                                                         keysum : SET);
  1384. BEGIN
  1385.     Texts.OpenWriter(W); Texts.OpenWriter(W0);
  1386.     Texts.SetFont(W0, Fonts.Default); Texts.SetColor(W0, Display.white); Texts.SetOffset(W0, 0);
  1387.     neutralize.id := Oberon.neutralize;
  1388.     NEW(par);
  1389.     NEW(B); Texts.OpenBuf(B);
  1390.     menuH := Fonts.Default.height + 2;
  1391.     barW := menuH; left := barW + 6; right := 8; top := 6; bot := 6;    (*CM  18.11.94 *)
  1392.     InitDefParc;
  1393.     NEW(scrollBar); scrollBar.Init; used := FALSE    (*CM  18.11.94 *)
  1394. END TextFrames.
  1395.